home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / region.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  22.2 KB  |  530 lines
  1. ;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base: 8.; Fonts: CPTFONT, CPTFONTB-*-
  2.  
  3. #||
  4.             Copyright 1985 Massachusetts Institute of Technology
  5.  
  6.  Permission to use, copy, modify, distribute, and sell this software
  7.  and its documentation for any purpose is hereby granted without fee,
  8.  provided that the above copyright notice appear in all copies and that
  9.  both that copyright notice and this permission notice appear in
  10.  supporting documentation, and that the name of M.I.T. not be used in
  11.  advertising or publicity pertaining to distribution of the software
  12.  without specific, written prior permission.  M.I.T. makes no
  13.  representations about the suitability of this software for any
  14.  purpose.  It is provided "as is" without express or implied warranty.
  15.  
  16.  
  17.                                           +-Data--+
  18.                  This file is part of the | BOXER | system
  19.                                           +-------+
  20.  
  21.  This file defines Boxer editor REGIONS
  22.  
  23.  A boxer region can have several different representations.  The region object should be
  24.  able to switch between these different representations easily.  These representations are:
  25.       A list of rows
  26.       A REGION STREAM which is similar to a BOX stream except that there is no PLIST info.
  27.       Two Boxer pointers (BP's) into existing editor stucture.
  28.  
  29.  In general, only one representation will be relevant at a given time.  For example, while
  30.  the user sets up the region in the editor, we use the BP representation.
  31.  If the region is Killed, then we need to store the killed region as a list of rows.  
  32.  Copying regions will probably use streams
  33.  
  34.  Regions are also responsible for updating their own redisplay
  35.  In many cases, this will probably involve allocating and deallocating several groups
  36.  of rectangular blinkers since there could be several screen objects for each row in the 
  37.  region. (Mark them all or just where we are ??)
  38.  
  39. Note, We call them EDITOR-REGIONs for now to avoid naming problems with the already existing
  40. flavor called REGION which is used in the redisplay
  41.  
  42.  Each Box is capable of having its own Region.  When the Box is FUNCALLed, only the 
  43.  contents of the Box which are in the Region will be seen by the Evaluator.
  44.  
  45. ||#
  46.  
  47. (DEFMETHOD (EDITOR-REGION :ROWS) ()
  48.   ROWS)
  49.  
  50. (DEFMETHOD (EDITOR-REGION :BLINKER-LIST) ()
  51.   BLINKER-LIST)
  52.  
  53. (DEFMETHOD (EDITOR-REGION :START-BP) ()
  54.   START-BP)
  55.  
  56. (DEFMETHOD (EDITOR-REGION :STOP-BP) ()
  57.   STOP-BP)
  58.  
  59. (DEFMETHOD (EDITOR-REGION :SET-START-BP) (NEW-START)
  60.   (CHECK-BP-ARG NEW-START)
  61.   (SETQ START-BP NEW-START))
  62.  
  63. (DEFMETHOD (EDITOR-REGION :SET-STOP-BP) (NEW-STOP)
  64.   (CHECK-BP-ARG NEW-STOP)
  65.   (SETQ STOP-BP NEW-STOP))
  66.  
  67. (DEFUN MAKE-EDITOR-REGION (START-BP &OPTIONAL (STOP-BP *POINT*))
  68.   (IF (AND (BP? START-BP) (BP? STOP-BP))
  69.       (MAKE-INSTANCE 'EDITOR-REGION ':START-BP START-BP ':STOP-BP STOP-BP)
  70.       (FERROR "One or both of the args: ~S, ~S was not a Boxer pointer" START-BP STOP-BP)))
  71.  
  72. ;;; This returns a list of ROWS of the lowest common superior box of the two BP's.  The list
  73. ;;; is ordered from top to bottom.  The method also returns start and stop BP's which
  74. ;;; correspond to the rows which are returned (not neccessarily where the BP's are located)
  75. ;;; The returned BP's are also guaranteed to be "ordered" from top to bottom AND 
  76. ;;; from left to right (if they are on the same line that is)
  77.  
  78. (DEFMETHOD (EDITOR-REGION :GET-ROWS-FROM-BPS) ()
  79.   (UNLESS (OR (NULL START-BP) (NULL STOP-BP))
  80.     (MULTIPLE-VALUE-BIND (TL-START-BP TL-STOP-BP)    ;bind the "top-level" BPs
  81.     (ORDER-BPS START-BP STOP-BP)
  82.       (LOOP FOR CURRENT-ROW = (BP-ROW TL-START-BP) THEN (TELL CURRENT-ROW :NEXT-ROW)
  83.         COLLECT CURRENT-ROW INTO RETURN-ROWS
  84.         UNTIL (EQ CURRENT-ROW (BP-ROW TL-STOP-BP))
  85.         FINALLY
  86.         (RETURN (VALUES RETURN-ROWS TL-START-BP TL-STOP-BP))))))
  87.  
  88. ;;; If you want to use all the values returned by the :GET-ROWS-FORM-BPS message
  89. ;;; then use this macro instead since it performs cleanup on the rows with the newly
  90. ;;; created BPs
  91.  
  92. (DEFMACRO WITH-REGION-ROWS-AND-BPS-BOUND ((EDITOR-REGION) &BODY BODY)
  93.     "Creates and environment with REGION-ROWS bound to the rows of the EDITOR-REGION and
  94. REGION-START-BP and REGION-STOP-BP bound to BPs which are at the same level and ordered.  
  95. Then cleans up afterwards.  "
  96.   `(MULTIPLE-VALUE-BIND (REGION-ROWS REGION-START-BP REGION-STOP-BP)
  97.        (TELL ,EDITOR-REGION :GET-ROWS-FROM-BPS)
  98.      (UNWIND-PROTECT
  99.        (PROGN . ,BODY)
  100.        (TELL (BP-ROW REGION-START-BP) :DELETE-BP REGION-START-BP)
  101.        (TELL (BP-ROW REGION-STOP-BP)  :DELETE-BP REGION-STOP-BP))))
  102.  
  103. (DEFMACRO WITH-REGION-TOP-LEVEL-BPS-BOUND ((EDITOR-REGION) &BODY BODY)
  104.   "Creates and environment with REGION-START-BP and REGION-STOP-BP bound to BPs which are at
  105. the same level and ordered.  Then cleans up afterwards.  "
  106.   `(MULTIPLE-VALUE-BIND (REGION-START-BP REGION-STOP-BP)
  107.        (ORDER-BPS (TELL ,EDITOR-REGION :START-BP) (TELL ,EDITOR-REGION :STOP-BP))
  108.      (UNWIND-PROTECT
  109.        (PROGN . ,BODY)
  110.        (TELL (BP-ROW REGION-START-BP) :DELETE-BP REGION-START-BP)
  111.        (TELL (BP-ROW REGION-STOP-BP)  :DELETE-BP REGION-STOP-BP))))
  112.  
  113. (DEFMETHOD (EDITOR-REGION :SET-ROWS) (ROWS-TO-SET)
  114.   ;; this converts the region's internal representation to rows ONLY.
  115.   (TELL SELF :MAKE-INVISIBLE)
  116.   ;; First we clean up any displayed blinkers that may exist
  117.   (DOLIST (BLINKER BLINKER-LIST)
  118.     (REMOVE-REGION-ROW-BLINKER BLINKER))
  119.   (SETQ BLINKER-LIST NIL)
  120.   ;; Then we get rid of the BP's since the region should probably NOT have any thing to do
  121.   ;; with REAL structure if we are sending this message to it
  122.   (SETQ START-BP NIL STOP-BP NIL)
  123.   ;; Finally, we set the rows to what they want to be
  124.   (SETQ ROWS ROWS-TO-SET))
  125.  
  126. (DEFMETHOD (EDITOR-REGION :COPY) ()
  127.   (LET ((NEW-REGION (MAKE-INSTANCE 'EDITOR-REGION)))
  128.     (TELL NEW-REGION :SET-ROWS (MAPCAR #'COPY-ROW ROWS))
  129.     NEW-REGION))
  130.  
  131. (DEFMETHOD (EDITOR-REGION :SET-BPS) (BP1 BP2)
  132.   ;; this converts the region's internal representation to BP's ONLY.
  133.   ;; first, clear out the rows
  134.   (SETQ ROWS NIL)
  135.   ;; now set the BP's
  136.   (SETQ START-BP BP1 STOP-BP BP2))
  137.  
  138. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  139. ;;;                     INTERACTIONS BETWEEN REGIONS AND BOXES                             ;;;
  140. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  141.  
  142. (DEFMETHOD (BOX :GET-REGION-CHECK-SUPERIORS) ()
  143.   (LET ((SUPERIOR-BOX (TELL SELF :SUPERIOR-BOX)))
  144.     (COND ((EDITOR-REGION? REGION) REGION)
  145.       ((BOX? SUPERIOR-BOX) (TELL SUPERIOR-BOX :GET-REGION-CHECK-SUPERIORS))
  146.       (T NIL))))
  147.  
  148. (DEFMETHOD (EDITOR-REGION :BOX) ()
  149.   BOX)
  150.  
  151. (DEFMETHOD (EDITOR-REGION :SET-BOX) (NEW-BOX)
  152.   (SETQ BOX NEW-BOX))
  153.  
  154. (DEFMETHOD (BOX :REGION) ()
  155.   REGION)
  156.  
  157. (DEFMETHOD (BOX :SET-REGION) (NEW-REGION)
  158.   (SETQ REGION NEW-REGION)
  159.   (TELL SELF :MODIFIED T))            ;flush the code cache
  160.  
  161. ;; Use this one from the outside since at some point in the future, we may allow more than 
  162. ;; one region in a BOX or ONLY one region in ALL of BOXER
  163. ;; No matter what, this is guaranteed to get you whatever the most appropriate region is if
  164. ;; it exists
  165.  
  166. (DEFUN GET-CURRENT-REGION ()
  167.   (TELL (POINT-BOX) :GET-REGION-CHECK-SUPERIORS))
  168.  
  169. (DEFUN GET-LOCAL-REGION (&OPTIONAL (BP *POINT*))
  170.   (TELL (BP-BOX BP) :REGION))
  171.  
  172. (DEFUN INSTALL-REGION (REGION &OPTIONAL (BP *POINT*))
  173.   (TELL REGION :SET-BOX (BP-BOX BP))
  174.   (TELL (BP-BOX BP) :SET-REGION REGION)
  175.   (COND-EVERY ((EQ REGION *REGION-BEING-DEFINED*)
  176.          (SETQ *REGION-BEING-DEFINED* NIL))
  177.         ((EQ REGION *FOLLOWING-MOUSE-REGION*)
  178.          (SETQ *FOLLOWING-MOUSE-REGION* NIL))))
  179.  
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181. ;;;                        TOP  LEVEL  REGION  MANIPULATING  COMMANDS                      ;;;
  182. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  183. ;;;
  184.  
  185. (DEFUN FLUSH-REGION (REGION)
  186.   (WHEN (NOT-NULL REGION)
  187.     (TELL REGION :MAKE-INVISIBLE)
  188.     (TELL-CHECK-NIL (TELL REGION :BOX) :SET-REGION NIL)
  189.     (DOLIST (BLINKER (TELL REGION :BLINKER-LIST))
  190.       (REMOVE-REGION-ROW-BLINKER BLINKER))
  191.     (SETQ REGION-LIST (DELQ REGION REGION-LIST))
  192.     (COND-EVERY ((EQ REGION *REGION-BEING-DEFINED*)
  193.          (SETQ *REGION-BEING-DEFINED* NIL))
  194.         ((EQ REGION *FOLLOWING-MOUSE-REGION*)
  195.          (SETQ *FOLLOWING-MOUSE-REGION* NIL)))))
  196.  
  197. ;;; As long as we keep the *POINT* and the *CURRENT-EDITOR-REGION* coupled...
  198. (DEFUN BP-IN-REGION? (BP REGION-ROWS)
  199.   BP REGION-ROWS
  200.   T)
  201.  
  202. (DEFUN KILL-REGION (REGION)
  203.   (WITH-REGION-ROWS-AND-BPS-BOUND (REGION)
  204.     (LET* ((FIRST-ROW (CAR REGION-ROWS))
  205.        (LAST-ROW (CAR (LAST REGION-ROWS)))
  206.        (REGION-BOX (TELL FIRST-ROW :SUPERIOR-BOX))
  207.        (MIDDLE-ROWS (BUTLAST (CDR REGION-ROWS)))
  208.        (FIRST-CHA-NO (BP-CHA-NO REGION-START-BP))
  209.        (LAST-CHA-NO (BP-CHA-NO REGION-STOP-BP)))
  210.       (COND ((EQ FIRST-ROW LAST-ROW)
  211.          (TELL REGION
  212.            :SET-ROWS
  213.            (LIST (TELL FIRST-ROW
  214.                    :DELETE-CHAS-BETWEEN-CHA-NOS FIRST-CHA-NO LAST-CHA-NO))))
  215.         (T
  216.          (TELL REGION
  217.            :SET-ROWS
  218.            (APPEND
  219.              (NCONS (TELL FIRST-ROW :KILL-CHAS-AT-CHA-NO FIRST-CHA-NO))
  220.              MIDDLE-ROWS
  221.              (NCONS (TELL LAST-ROW
  222.                   :DELETE-CHAS-BETWEEN-CHA-NOS 0 LAST-CHA-NO))))
  223.          (UNLESS (NULL MIDDLE-ROWS)
  224.            (TELL REGION-BOX :DELETE-BETWEEN-ROWS (CAR MIDDLE-ROWS)
  225.              (CAR (LAST MIDDLE-ROWS))))
  226.            (TELL FIRST-ROW :INSERT-ROW-CHAS-AT-CHA-NO LAST-ROW FIRST-CHA-NO)
  227.            (TELL REGION-BOX :DELETE-ROW LAST-ROW)))
  228.       ;;; Clean up time
  229.       (WHEN (BP-IN-REGION? *POINT* REGION-ROWS)
  230.     (LET ((REGION-SCREEN-BOX (OR (TELL-CHECK-NIL (CURRENT-SCREEN-ROW FIRST-ROW)
  231.                              :SCREEN-BOX)
  232.                      (TELL (CAR (MEM #'(LAMBDA (BOX ROW)
  233.                              (TELL BOX :SUPERIOR? ROW))
  234.                              (BP-SCREEN-BOX *POINT*)
  235.                              (LOOP FOR ROW IN REGION-ROWS
  236.                                APPEND
  237.                                (TELL ROW
  238.                                  :DISPLAYED-SCREEN-OBJS))))
  239.                        :SCREEN-BOX))))
  240.       (MOVE-POINT-1 FIRST-ROW FIRST-CHA-NO REGION-SCREEN-BOX))))))
  241.  
  242. (DEFUN YANK-REGION (BP REGION &OPTIONAL (FORCE-BP-TYPE ':MOVING)
  243.             &AUX (NEW-START-BP (MAKE-BP ':FIXED))
  244.             (NEW-STOP-BP (MAKE-BP ':FIXED)))
  245.   (ACTION-AT-BP-INTERNAL
  246.     (LET* ((BOX (BP-BOX BP))
  247.        (ROW (BP-ROW BP))
  248.        (CHA-NO (BP-CHA-NO BP))
  249.        (REMAINS (TELL ROW :KILL-CHAS-AT-CHA-NO CHA-NO))
  250.        (FIRST-NEW-ROW (CAR (TELL REGION :ROWS)))
  251.        (REST-NEW-ROWS (CDR (TELL REGION :ROWS)))
  252.        (LAST-NEW-ROW (CAR (LAST REST-NEW-ROWS))))
  253.       ;;remember where we are
  254.       (MOVE-BP NEW-START-BP (BP-VALUES BP))
  255.       ;; add the region
  256.       (TELL ROW :INSERT-ROW-CHAS-AT-CHA-NO FIRST-NEW-ROW CHA-NO)
  257.       (IF (NULL REST-NEW-ROWS)
  258.       (TELL ROW :INSERT-ROW-CHAS-AT-CHA-NO REMAINS (TELL ROW :LENGTH-IN-CHAS))
  259.       (LOOP FOR NEW-ROW IN REST-NEW-ROWS
  260.         FOR CURRENT-ROW = ROW THEN (TELL CURRENT-ROW :NEXT-ROW)
  261.         DO (TELL BOX :INSERT-ROW-AFTER-ROW NEW-ROW CURRENT-ROW)
  262.         FINALLY (TELL LAST-NEW-ROW
  263.                   :INSERT-ROW-CHAS-AT-CHA-NO REMAINS
  264.                   (TELL LAST-NEW-ROW :LENGTH-IN-CHAS))))
  265.       ;; now remember where we stopped
  266.       (MOVE-BP NEW-STOP-BP (BP-VALUES BP))
  267.       ;; now tell the region about it
  268.       (TELL REGION :SET-BPS NEW-START-BP NEW-STOP-BP))))
  269.  
  270. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  271. ;;;                                   Redisplay  of  REGIONS                               ;;;
  272. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  273. ;;;
  274. ;;; Regions are displayed as one or more blinkers.  With Each blinker corresponding to screen
  275. ;;; representation(s) for the rows which make up the region
  276.  
  277. (DEFUN MAKE-REGION-ROW-BLINKER (SCREEN-ROW)
  278.   (LET ((NEW-BLINKER (TV:MAKE-BLINKER *BOXER-PANE* 'REGION-ROW-BLINKER
  279.                                    ':VISIBILITY NIL ':FOLLOW-P NIL)))
  280.     (SETF (REGION-ROW-BLINKER-UID NEW-BLINKER) SCREEN-ROW)
  281.     NEW-BLINKER))
  282.  
  283. (DEFMETHOD (EDITOR-REGION :TURN-ON) ()
  284.   (UNLESS VISIBILITY
  285.     (TELL SELF :MAKE-VISIBLE))
  286.   (SETQ VISIBILITY T))
  287.  
  288. (DEFMETHOD (EDITOR-REGION :TURN-OFF) ()
  289.   (WHEN VISIBILITY
  290.     (TELL SELF :MAKE-INVISIBLE))
  291.   (SETQ VISIBILITY NIL))
  292.  
  293. ;;; We provide two different messages for redisplay of regions.  One of them will just mark 
  294. ;;; the screen rows corresponding to the region in the *CURRENT-SCREEN-BOX* while the other
  295. ;;; one will mark *ALL* the screen rows of the region.
  296. (DEFUN REMOVE-REGION-ROW-BLINKER (ROW-BLINKER)
  297.   (ALTERING-REGION (ROW-BLINKER)
  298.     (SETF (TV:SHEET-BLINKER-LIST *BOXER-PANE*)
  299.       (DELQ ROW-BLINKER (TV:SHEET-BLINKER-LIST *BOXER-PANE*)))))
  300.  
  301. (DEFUN UPDATE-ROW-BLINKER-LIST (ROW-BLINKERS SCREEN-ROWS)
  302.   "A blinker for every row and no extra blinkers. Returns a list of blinkers"
  303.   (LOOP FOR SCREEN-ROW IN SCREEN-ROWS
  304.     COLLECT (LET ((EXISTING-REGION
  305.             (CAR (MEM #'(LAMBDA (UID REG) (EQ UID (REGION-ROW-BLINKER-UID REG)))
  306.                   SCREEN-ROW ROW-BLINKERS))))
  307.           (IF (NULL EXISTING-REGION)
  308.               (MAKE-REGION-ROW-BLINKER SCREEN-ROW)
  309.               (SETQ ROW-BLINKERS (DELQ EXISTING-REGION ROW-BLINKERS))
  310.               EXISTING-REGION))
  311.     INTO NEW-LIST
  312.     FINALLY (PROGN (DOLIST (OLD-BLINKER ROW-BLINKERS)
  313.              (REMOVE-REGION-ROW-BLINKER OLD-BLINKER))
  314.                (RETURN NEW-LIST))))
  315.  
  316. ;;; Accessor Macros...
  317. (DEFSUBST REGION-ROW-BLINKER-WID (REGION)
  318.   (SYMEVAL-IN-INSTANCE REGION 'TV:WIDTH))
  319.  
  320. (DEFSUBST REGION-ROW-BLINKER-HEI (REGION)
  321.   (SYMEVAL-IN-INSTANCE REGION 'TV:HEIGHT))
  322.  
  323. (DEFSUBST REGION-ROW-BLINKER-X (REGION)
  324.   (TV:BLINKER-X-POS REGION))
  325.  
  326. (DEFSUBST REGION-ROW-BLINKER-Y (REGION)
  327.   (TV:BLINKER-Y-POS REGION))
  328.  
  329. ;; Blinkers positions are with respect to the window WITH THE BORDERS INCLUDED 
  330. (DEFMACRO FIXUP-COORDINATES-FOR-BLINKER (X Y BL)
  331.   `(LET ((SHEET (SEND ,BL :SHEET)))
  332.      (SETF ,X (+ ,X (SEND SHEET :LEFT-MARGIN-SIZE)))
  333.      (SETF ,Y (+ ,Y (SEND SHEET :TOP-MARGIN-SIZE)))))
  334.  
  335. (DEFUN UPDATE-REGION-ROW-BLINKER (REGION-ROW-BLINKER)
  336.   (LET* ((SCREEN-ROW (REGION-ROW-BLINKER-UID REGION-ROW-BLINKER))
  337.      (WID (SCREEN-OBJ-WID SCREEN-ROW))
  338.      (HEI (SCREEN-OBJ-HEI SCREEN-ROW)))
  339.     (MULTIPLE-VALUE-BIND (X Y)
  340.     (TELL SCREEN-ROW :POSITION)
  341.       ;; Blinker positions are measured with the borders included
  342.       (FIXUP-COORDINATES-FOR-BLINKER X Y REGION-ROW-BLINKER)
  343.       (WHEN (OR ( WID (REGION-ROW-BLINKER-WID REGION-ROW-BLINKER))
  344.         ( HEI (REGION-ROW-BLINKER-HEI REGION-ROW-BLINKER))
  345.         ( X   (REGION-ROW-BLINKER-X   REGION-ROW-BLINKER))
  346.         ( Y   (REGION-ROW-BLINKER-Y   REGION-ROW-BLINKER)))
  347.     ;; might be better to use timestamps (we might have to use timestamps in addition)
  348.     (ALTERING-REGION (REGION-ROW-BLINKER)
  349.       (SETF (REGION-ROW-BLINKER-WID REGION-ROW-BLINKER) WID)
  350.       (SETF (REGION-ROW-BLINKER-HEI REGION-ROW-BLINKER) HEI)
  351.       (SETF (REGION-ROW-BLINKER-X REGION-ROW-BLINKER) X)
  352.       (SETF (REGION-ROW-BLINKER-Y REGION-ROW-BLINKER) Y))))))
  353.  
  354. (DEFUN LEFT-HALF-BLINKER-TRIM (BLINKER CHA-NO)
  355.   (LET* ((SCREEN-ROW (REGION-ROW-BLINKER-UID BLINKER))
  356.      (SCREEN-CHAS (TELL SCREEN-ROW :SCREEN-CHAS))
  357.      (ROW-WID (TELL SCREEN-ROW :WID))
  358.      (ROW-HEI (TELL SCREEN-ROW :HEI))
  359.      (AMOUNT-TO-TRIM (LOOP FOR INDEX FROM 0 BELOW CHA-NO
  360.                    FOR CHA IN SCREEN-CHAS
  361.                    SUMMING (IF (SCREEN-CHA? CHA)
  362.                        (CHA-WID (FONT-NO CHA) (CHA-CODE CHA))
  363.                        (SCREEN-OBJ-WID CHA))))
  364.      (DESIRED-WID (- ROW-WID AMOUNT-TO-TRIM)))
  365.     (MULTIPLE-VALUE-BIND (X Y)
  366.     (TELL SCREEN-ROW :POSITION)
  367.       ;; Blinker positions are measured with the borders included
  368.       (FIXUP-COORDINATES-FOR-BLINKER X Y BLINKER)
  369.       (WHEN (OR ( DESIRED-WID          (REGION-ROW-BLINKER-WID BLINKER))
  370.         ( ROW-HEI              (REGION-ROW-BLINKER-HEI BLINKER))
  371.         ( (+ X AMOUNT-TO-TRIM) (REGION-ROW-BLINKER-X   BLINKER))
  372.         ( Y                    (REGION-ROW-BLINKER-Y   BLINKER)))
  373.     (ALTERING-REGION (BLINKER)
  374.       (SETF (REGION-ROW-BLINKER-WID BLINKER) DESIRED-WID)
  375.       (SETF (REGION-ROW-BLINKER-HEI BLINKER) ROW-HEI)
  376.       (SETF (REGION-ROW-BLINKER-X   BLINKER) (+ X AMOUNT-TO-TRIM))
  377.       (SETF (REGION-ROW-BLINKER-Y   BLINKER) Y))))))
  378.  
  379. (DEFUN RIGHT-HALF-BLINKER-TRIM (BLINKER CHA-NO)
  380.   (LET* ((SCREEN-ROW (REGION-ROW-BLINKER-UID BLINKER))
  381.      (SCREEN-CHAS (TELL SCREEN-ROW :SCREEN-CHAS))
  382.      (ROW-WID (TELL SCREEN-ROW :WID))
  383.      (ROW-HEI (TELL SCREEN-ROW :HEI))
  384.      (AMOUNT-TO-TRIM (IF ( CHA-NO (TELL SCREEN-ROW :LENGTH))
  385.                  0
  386.                  (LOOP FOR CHA IN (NTHCDR CHA-NO SCREEN-CHAS)
  387.                    SUMMING (IF (SCREEN-CHA? CHA)
  388.                            (CHA-WID (FONT-NO CHA) (CHA-CODE CHA))
  389.                            (SCREEN-OBJ-WID CHA)))))
  390.      (DESIRED-WID (- ROW-WID AMOUNT-TO-TRIM)))
  391.     (MULTIPLE-VALUE-BIND (X Y)
  392.     (TELL SCREEN-ROW :POSITION)
  393.       ;; Blinker positions are measured with the borders included
  394.       (FIXUP-COORDINATES-FOR-BLINKER X Y BLINKER)
  395.       (WHEN (OR ( DESIRED-WID (REGION-ROW-BLINKER-WID BLINKER))
  396.         ( ROW-HEI     (REGION-ROW-BLINKER-HEI BLINKER))
  397.         ( X           (REGION-ROW-BLINKER-X   BLINKER))
  398.         ( Y           (REGION-ROW-BLINKER-Y   BLINKER)))
  399.     (ALTERING-REGION (BLINKER)
  400.       (SETF (REGION-ROW-BLINKER-WID BLINKER) DESIRED-WID)
  401.       (SETF (REGION-ROW-BLINKER-HEI BLINKER) ROW-HEI)
  402.       (SETF (REGION-ROW-BLINKER-X   BLINKER) X)
  403.       (SETF (REGION-ROW-BLINKER-Y   BLINKER) Y))))))
  404.  
  405. (DEFUN BOTH-ENDS-BLINKER-TRIM (BLINKER START-CHA-NO STOP-CHA-NO)
  406.   (LET* ((SCREEN-ROW (REGION-ROW-BLINKER-UID BLINKER))
  407.      (SCREEN-CHAS (TELL SCREEN-ROW :SCREEN-CHAS))
  408.      (ROW-WID (TELL SCREEN-ROW :WID))
  409.      (ROW-HEI (TELL SCREEN-ROW :HEI))
  410.      (LEFT-TRIM (LOOP FOR INDEX FROM 0 BELOW START-CHA-NO
  411.               FOR CHA IN SCREEN-CHAS
  412.               SUMMING (IF (SCREEN-CHA? CHA)
  413.                       (CHA-WID (FONT-NO CHA) (CHA-CODE CHA))
  414.                       (SCREEN-OBJ-WID CHA))))
  415.      (RIGHT-TRIM (IF ( STOP-CHA-NO (TELL SCREEN-ROW :LENGTH))
  416.              0
  417.              (LOOP FOR CHA IN (NTHCDR STOP-CHA-NO SCREEN-CHAS)
  418.                    SUMMING (IF (SCREEN-CHA? CHA)
  419.                        (CHA-WID (FONT-NO CHA) (CHA-CODE CHA))
  420.                        (SCREEN-OBJ-WID CHA)))))
  421.      (DESIRED-WID (- ROW-WID LEFT-TRIM RIGHT-TRIM)))
  422.     (MULTIPLE-VALUE-BIND (X Y)
  423.     (TELL SCREEN-ROW :POSITION)
  424.       ;; Blinker positions are measured with the borders included
  425.       (FIXUP-COORDINATES-FOR-BLINKER X Y BLINKER)
  426.       (WHEN (OR ( DESIRED-WID     (REGION-ROW-BLINKER-WID BLINKER))
  427.         ( ROW-HEI         (REGION-ROW-BLINKER-HEI BLINKER))
  428.         ( (+ X LEFT-TRIM) (REGION-ROW-BLINKER-X   BLINKER))
  429.         ( Y               (REGION-ROW-BLINKER-Y   BLINKER)))
  430.     (ALTERING-REGION (BLINKER)
  431.       (SETF (REGION-ROW-BLINKER-WID BLINKER) DESIRED-WID)
  432.       (SETF (REGION-ROW-BLINKER-HEI BLINKER) ROW-HEI)
  433.       (SETF (REGION-ROW-BLINKER-X   BLINKER) (+ X LEFT-TRIM))
  434.       (SETF (REGION-ROW-BLINKER-Y   BLINKER) Y))))))
  435.  
  436. (DEFMETHOD (EDITOR-REGION :UPDATE-REDISPLAY-ALL-ROWS) ()
  437.   (WITH-FONT-MAP-BOUND (*BOXER-PANE*)
  438.     ;; we have to bind this because region redisplay can be called OUTSIDE of normal redisplay
  439.     (COND ((OR (NULL START-BP) (NULL STOP-BP))
  440.        ;; No BP's mean that there is not any screen structure. Probably a region got wiped
  441.        (DOLIST (BLINKER BLINKER-LIST)
  442.          (REMOVE-REGION-ROW-BLINKER BLINKER))
  443.        (SETQ BLINKER-LIST NIL))
  444.       (T
  445.        (WITH-REGION-ROWS-AND-BPS-BOUND (SELF)
  446.          ;; First we do "allocation" that is, make sure that there is a blinker for every 
  447.          ;; screen row and vice versa.  Note that blinker list will be ordered from top
  448.          ;; to bottom
  449.          (SETQ BLINKER-LIST
  450.            (UPDATE-ROW-BLINKER-LIST BLINKER-LIST
  451.                         (LOOP FOR ROW IN REGION-ROWS
  452.                           APPEND
  453.                           (TELL ROW :DISPLAYED-SCREEN-OBJS))))
  454.          (IF VISIBILITY (TELL SELF :MAKE-VISIBLE) (TELL SELF :MAKE-INVISIBLE))
  455.          (LET ((STARTING-ROW (BP-ROW REGION-START-BP))
  456.            (STARTING-CHA-NO (BP-CHA-NO REGION-START-BP))
  457.            (STOPPING-ROW (BP-ROW REGION-STOP-BP))
  458.            (STOPPING-CHA-NO (BP-CHA-NO REGION-STOP-BP)))
  459.            (LOOP FOR BLINKER IN BLINKER-LIST
  460.              FOR BLINKER-ROW = (REGION-ROW-BLINKER-UID BLINKER)
  461.              DOING
  462.              (COND ((AND (EQ STARTING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  463.                  (EQ STOPPING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ)))
  464.                 ;; the row is both the first and last one in a region so we should
  465.                 ;; trim both ends of it
  466.                 (BOTH-ENDS-BLINKER-TRIM BLINKER STARTING-CHA-NO STOPPING-CHA-NO))
  467.                ((EQ STARTING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  468.                 ;; If the row is the first one in a region then it needs to be
  469.                 ;; trimmed to correspond to where the BP is pointing
  470.                 (LEFT-HALF-BLINKER-TRIM BLINKER STARTING-CHA-NO))
  471.                ((EQ STOPPING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  472.                 ;; If the row is the last one in the region, then it ALSO needs
  473.                 ;; to be trimmed to correspond to where the BP is pointing
  474.                 (RIGHT-HALF-BLINKER-TRIM BLINKER STOPPING-CHA-NO))
  475.                (T
  476.                 ;; finally, take care of all the other rows
  477.                 (UPDATE-REGION-ROW-BLINKER BLINKER))))))))))
  478.  
  479. (DEFMETHOD (EDITOR-REGION :UPDATE-REDISPLAY-CURRENT-ROWS) ()
  480.   (WITH-FONT-MAP-BOUND (*BOXER-PANE*)
  481.     (COND ((OR (NULL START-BP) (NULL STOP-BP))
  482.        ;; No BP's mean that there is not any screen structure. Probably a region got wiped
  483.        (DOLIST (BLINKER BLINKER-LIST)
  484.          (REMOVE-REGION-ROW-BLINKER BLINKER))
  485.        (SETQ BLINKER-LIST NIL))
  486.       (T
  487.        (WITH-REGION-ROWS-AND-BPS-BOUND (SELF)
  488.          ;; First we do "allocation" that is, make sure that there is a blinker for every 
  489.          ;; screen row and vice versa.  Note that blinker list will be ordered from top
  490.          ;; to bottom
  491.          (SETQ BLINKER-LIST
  492.            (UPDATE-ROW-BLINKER-LIST BLINKER-LIST
  493.                         (LOOP FOR ROW IN REGION-ROWS
  494.                           COLLECT (CURRENT-SCREEN-ROW ROW))))
  495.          (IF VISIBILITY (TELL SELF :MAKE-VISIBLE) (TELL SELF :MAKE-INVISIBLE))
  496.          (LET ((STARTING-ROW (BP-ROW REGION-START-BP))
  497.            (STARTING-CHA-NO (BP-CHA-NO REGION-START-BP))
  498.            (STOPPING-ROW (BP-ROW REGION-STOP-BP))
  499.            (STOPPING-CHA-NO (BP-CHA-NO REGION-STOP-BP)))
  500.            (LOOP FOR BLINKER IN BLINKER-LIST
  501.              FOR BLINKER-ROW = (REGION-ROW-BLINKER-UID BLINKER)
  502.              DOING
  503.              (COND ((AND (EQ STARTING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  504.                  (EQ STARTING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ)))
  505.                 ;; the row is both the first and last one in a region so we should
  506.                 ;; trim both ends of it
  507.                 (BOTH-ENDS-BLINKER-TRIM BLINKER STARTING-CHA-NO STOPPING-CHA-NO))
  508.                ((EQ STARTING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  509.                 ;; If the row is the first one in a region then it needs to be
  510.                 ;; trimmed to correspond to where the BP is pointing
  511.                 (LEFT-HALF-BLINKER-TRIM BLINKER STARTING-CHA-NO))
  512.                ((EQ STOPPING-ROW (TELL BLINKER-ROW :ACTUAL-OBJ))
  513.                 ;; If the row is the last one in the region, then it ALSO needs
  514.                 ;; to be trimmed to correspond to where the BP is pointing
  515.                 (RIGHT-HALF-BLINKER-TRIM BLINKER STOPPING-CHA-NO))
  516.                (T
  517.                 ;; finally, take care of all the other rows
  518.                 (UPDATE-REGION-ROW-BLINKER BLINKER))))))))))
  519.  
  520. (DEFMETHOD (EDITOR-REGION :MAKE-VISIBLE) ()
  521.   (DOLIST (ROW-BLINKER BLINKER-LIST)
  522.     (TELL ROW-BLINKER :SET-VISIBILITY T)))
  523.  
  524. (DEFMETHOD (EDITOR-REGION :MAKE-INVISIBLE) ()
  525.   (DOLIST (ROW-BLINKER BLINKER-LIST)
  526.     (TELL ROW-BLINKER :SET-VISIBILITY NIL)))
  527.  
  528.  
  529.  
  530.